home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / gfa / gfaexprt.lzh / GFAXPERT.LIB / TEXT.LST < prev    next >
Encoding:
File List  |  1986-10-19  |  9.3 KB  |  343 lines
  1. ' ****************
  2. ' *** TEXT.LST ***
  3. ' ****************
  4. '
  5. DEFWRD "a-z"
  6. '
  7. > PROCEDURE font.8x16
  8.   ' *** 8x16 font (width 8 pixels, height 16 pixels) for PRINT-command
  9.   ' *** equals DEFTEXT ,,,13 for TEXT-command
  10.   ' *** this is the default system-font in High resolution
  11.   ' *** uses/changes Standard Globals
  12.   LOCAL a$,adr%
  13.   a$=MKI$(&HA000)+MKI$(&H2009)+MKI$(&H4E75)     ! MOVE.L  A1,D0  RTS
  14.   adr%=VARPTR(a$)
  15.   adr%=C:adr%()         ! address of font-table
  16.   {INTIN}={adr%+8}      ! pointer to 8x16 system-font (3rd pointer)
  17.   VDISYS 5,2,0,102      ! Init System Font (VDI 5, Escape 102 ; undocumented ?)
  18.   char.height=16
  19.   scrn.lin.max=(scrn.y.max+1)/char.height
  20. RETURN
  21. ' ***
  22. > PROCEDURE font.8x8
  23.   ' *** 8x8 font for PRINT-command
  24.   ' *** equals DEFTEXT ,,,6 for TEXT-command
  25.   ' *** this is the default system-font in Low and Medium resolution
  26.   ' *** uses/changes Standard Globals
  27.   LOCAL a$,adr%
  28.   a$=MKI$(&HA000)+MKI$(&H2009)+MKI$(&H4E75)     ! MOVE.L  A1,D0  RTS
  29.   adr%=VARPTR(a$)
  30.   adr%=C:adr%()         ! address of font-table
  31.   {INTIN}={adr%+4}      ! pointer to 8x8 system-font (2nd pointer)
  32.   VDISYS 5,2,0,102      ! Init System Font (VDI 5, Escape 102 ; undocumented ?)
  33.   char.height=8
  34.   scrn.lin.max=(scrn.y.max+1)/char.height
  35. RETURN
  36. ' **********
  37. '
  38. > PROCEDURE change.font
  39.   ' *** change PRINT-font for High resolution
  40.   ' *** use A1_xxxxx.FON-files created with FONTKIT (by Jeremy Hughes)
  41.   ' *** restore original system-font with @normal.font
  42.   ' *** uses Standard Global
  43.   ' *** global :   NEW.FONT!   NORMAL.FONT%
  44.   LOCAL adr%,new.font%
  45.   IF high.res!
  46.     '
  47.     ' *** load A1_xxxxx.INL file (4114 bytes) from FONTS-folder here
  48.     ' *** any regular Atari-font (4096 bytes) can be loaded as well !
  49.     INLINE new.font%,4114
  50.     '
  51.     adr%=L~A-22
  52.     normal.font%={adr%}
  53.     SLPOKE adr%,new.font%
  54.     new.font!=TRUE
  55.   ENDIF
  56. RETURN
  57. ' ***
  58. > PROCEDURE normal.font
  59.   ' *** restore default system-font
  60.   IF new.font!
  61.     SLPOKE L~A-22,normal.font%
  62.     new.font!=FALSE
  63.   ENDIF
  64. RETURN
  65. ' **********
  66. '
  67. > PROCEDURE scroll.print(txt$,col,lin,width)
  68.   ' *** scroll text with PRINT in box (width in characters)
  69.   ' *** quit after any keypress (complete string is printed before exit)
  70.   ' *** uses Standard Global
  71.   LOCAL a$,n,x1.box,y1.box,x2.box,y2.box
  72.   x1.box=col*8-9
  73.   y1.box=lin*char.height-(char.height+2)
  74.   x2.box=x1.box+width*8+1
  75.   y2.box=y1.box+char.height+3
  76.   BOX x1.box,y1.box,x2.box,y2.box
  77.   a$=SPACE$(width-1)+txt$+" "
  78.   REPEAT
  79.   UNTIL INKEY$=""
  80.   REPEAT
  81.     FOR n=1 TO LEN(a$)
  82.       PRINT AT(col,lin);MID$(a$,n,width);
  83.       PAUSE 7
  84.     NEXT n
  85.   UNTIL INKEY$<>""
  86. RETURN
  87. ' **********
  88. '
  89. > PROCEDURE scroll.text(txt$,x,y,w,h)
  90.   ' *** scroll text with TEXT in box with width w pixels and height h pixels
  91.   ' *** uses Procedure Set.clip.rectangle and Txt.extent
  92.   ' *** also uses Procedure Initio.logical.screen etc.
  93.   LOCAL txt.y,width,height,screen$,n,in$
  94.   DEFFILL white,1
  95.   BOX x,y,x+w,y+h
  96.   CLIP x+1,y+1 TO x+w-1,y+h-1
  97.   @text.extent(txt$,width,height)
  98.   txt.y=y+(h-height)/2+height-2
  99.   SGET screen$
  100.   @initio.logical.screen
  101.   CLS
  102.   SPUT screen$
  103.   REPEAT
  104.     FOR n=x+w TO x-width STEP -2
  105.       in$=INKEY$
  106.       EXIT IF in$<>""
  107.       TEXT n,txt.y,txt$
  108.       @swap.screen
  109.       PBOX x+1,y+1,x+w-1,y+h-1
  110.       PAUSE 1
  111.     NEXT n
  112.   UNTIL in$<>""
  113.   CLIP OFF
  114.   @restore.physical.screen
  115. RETURN
  116. ' **********
  117. '
  118. > PROCEDURE sound.txt(txt$)
  119.   ' *** play scale while text appears
  120.   LOCAL octave,n
  121.   octave=3
  122.   FOR n=1 TO LEN(txt$)
  123.     PRINT MID$(txt$,n,1);
  124.     IF n MOD 12=0
  125.       INC octave
  126.     ENDIF
  127.     SOUND 1,13,n MOD 12,octave,5
  128.   NEXT n
  129.   SOUND 1,0,0,0,0
  130. RETURN
  131. ' **********
  132. '
  133. > PROCEDURE bell.txt(txt$,number)
  134.   ' *** flash text several times with bell-sound (at current cursor-position)
  135.   LOCAL x,y,n
  136.   x=CRSCOL
  137.   y=CRSLIN
  138.   FOR n=1 TO number
  139.     PRINT AT(x,y);txt$;
  140.     PRINT bel$;
  141.     PAUSE 15
  142.     PRINT AT(x,y);SPACE$(LEN(txt$));
  143.     PAUSE 15
  144.   NEXT n
  145.   PRINT AT(x,y);txt$;
  146. RETURN
  147. ' **********
  148. '
  149. > PROCEDURE text.parameters(VAR color,attr,angle,height)
  150.   ' *** text-parameters : color, attribute, angle, height (as in DEFTEXT)
  151.   ' *** I can't find attribute with Intout + 10 (bug in GEM ?)
  152.   DPOKE CONTRL,38
  153.   DPOKE CONTRL+2,0
  154.   DPOKE CONTRL+4,2
  155.   DPOKE CONTRL+6,0
  156.   DPOKE CONTRL+8,6
  157.   VDISYS
  158.   color=DPEEK(INTOUT+2)
  159.   attr=WORD{L~A+90}             ! find attribute somewhere else
  160.   angle=DPEEK(INTOUT+4)
  161.   height=DPEEK(PTSOUT+2)
  162. RETURN
  163. ' **********
  164. '
  165. > PROCEDURE text.extent(txt$,VAR width,height)
  166.   ' *** calculate width and height of text-box (printed with TEXT)
  167.   ' *** should make life easier if you want to enclose text in a rectangle
  168.   ' *** you'll have to experiment a little, especially if angle <> 0
  169.   ' *** uses Procedure Text.parameters to determine angle
  170.   LOCAL l,l$,n,x1,y1,x2,y2,x3,y3,x4,y4,k,angle,b,h
  171.   ~VQT_EXTENT(txt$,x1,y1,x2,y2,x3,y3,x4,y4)
  172.   @text.parameters(k,angle,b,h)
  173.   IF angle=0
  174.     width=x2
  175.     height=y3
  176.   ELSE IF angle=900
  177.     width=x1
  178.     height=y2
  179.   ELSE IF angle=1800
  180.     width=x1
  181.     height=y2
  182.   ELSE IF angle=2700
  183.     width=x3
  184.     height=x4                      ! bug in GEM (?) : y1,x4 and y4 wrong
  185.   ENDIF                            !                 (x4 and y4 are swapped)
  186. RETURN
  187. ' **********
  188. '
  189. > PROCEDURE shadow.box(x1,y1,x2,y2)
  190.   ' *** box with shadow (looks nice around text)
  191.   BOX x1,y1,x2,y2
  192.   DEFLINE 1,3
  193.   DRAW x1+3,y2+1 TO x2+2,y2+1 TO x2+2,y1+3
  194. RETURN
  195. ' **********
  196. '
  197. > PROCEDURE shadow.text(x,y,txt$)
  198.   ' *** print large 'shadowed' text with TEXT
  199.   ' *** use spaces between characters !
  200.   ' *** uses Standard Globals
  201.   GRAPHMODE 2
  202.   DEFTEXT black,0,0,32
  203.   TEXT x,y,txt$
  204.   TEXT x+2,y,txt$
  205.   FOR i=4 TO 6
  206.     TEXT x+i,y+i,txt$
  207.   NEXT i
  208.   GRAPHMODE 3
  209.   DEFTEXT white
  210.   TEXT x+1,y+1,txt$
  211.   GRAPHMODE 1
  212.   DEFTEXT black
  213. RETURN
  214. ' **********
  215. '
  216. > PROCEDURE flash(x1,y1,x2,y2,n)
  217.   ' *** flash rectangle (with text) n times
  218.   LOCAL flash$,i
  219.   GET x1,y1,x2,y2,flash$
  220.   FOR i=1 TO n
  221.     PUT x1,y1,flash$,12
  222.     PAUSE 25
  223.     PUT x1,y1,flash$
  224.     PAUSE 25
  225.   NEXT i
  226. RETURN
  227. ' **********
  228. '
  229. > PROCEDURE text.at(col,lin,txt$)
  230.   ' *** equals PRINT AT if same font-size is used (DEFTEXT ,,,13 or 6)
  231.   ' *** uses Standard Globals
  232.   TEXT (col-1)*char.width,lin*char.height+3*high.res!+2*(NOT high.res!),txt$
  233. RETURN
  234. ' **********
  235. '
  236. > PROCEDURE scroll.text.up(begin,end)
  237.   ' *** scroll lines (begin-end) 1 line up
  238.   ' *** this is much faster than PRINTing the lines again after CLS
  239.   ' *** uses Standard Globals
  240.   LOCAL screen%,sx,sy,w,h,dx,dy
  241.   IF begin>1 AND end>=begin
  242.     screen%=XBIOS(3)          ! logical screen
  243.     sx=0
  244.     sy=(begin-1)*char.height
  245.     w=scrn.x.max
  246.     h=(end-begin+1)*char.height
  247.     dx=0
  248.     dy=sy-char.height
  249.     RC_COPY screen%,sx,sy,w,h TO screen%,dx,dy
  250.   ELSE
  251.     PRINT bel$;
  252.   ENDIF
  253. RETURN
  254. ' **********
  255. '
  256. > PROCEDURE scroll.text.down(begin,end)
  257.   ' *** scroll lines begin-end 1 line down
  258.   ' *** this is much faster than PRINTing the lines again after CLS
  259.   ' *** uses Standard Globals
  260.   LOCAL screen%,sx,sy,w,h,dx,dy
  261.   IF end<scrn.lin.max AND end>=begin
  262.     screen%=XBIOS(3)          ! logical screen
  263.     sx=0
  264.     sy=(begin-1)*char.height
  265.     w=scrn.x.max
  266.     h=(end-begin+1)*char.height
  267.     dx=0
  268.     dy=sy+char.height
  269.     RC_COPY screen%,sx,sy,w,h TO screen%,dx,dy
  270.   ELSE
  271.     PRINT bel$;
  272.   ENDIF
  273. RETURN
  274. ' **********
  275. '
  276. > PROCEDURE box.text(x1,y1,x2,y2,txt$)
  277.   ' *** print inverted text (default system-font) in a box with TEXT
  278.   ' *** use (at least one) space as first and last character of txt$ !!
  279.   ' *** High resolution only
  280.   GRAPHMODE 1
  281.   DEFFILL 1,2,8
  282.   PBOX x1,y1,x2,y2
  283.   COLOR 0
  284.   BOX x1+1,y1+1,x2-1,y2-1
  285.   DEFTEXT 1,0,0,13
  286.   GRAPHMODE 3
  287.   TEXT x1,y1+(y2-y1)/2+6,x2-x1,txt$
  288.   GRAPHMODE 1
  289. RETURN
  290. ' **********
  291. '
  292. > PROCEDURE fast.print(line,txt$)
  293.   ' *** PRINT txt$ at line (1-25); much faster than PRINT AT(1,line);txt$
  294.   ' *** High-resolution only !!
  295.   ' *** no VT52-commands (e.g. reverse text) possible !!
  296.   ' *** length of txt$ must not exceed 80 characters !!
  297.   ' *** replace length with MIN(LEN(txt$)-1,79) if larger length possible
  298.   ' *** use XBIOS(3) instead of XBIOS(2) for (invisible) logical screen
  299.   ' *** routine by Peter Schapermeier
  300.   '
  301.   ' *** load FASTPRT.INL (150 bytes) here
  302.   INLINE fast.print%,150
  303.   '
  304.   VOID C:fast.print%(L:V:txt$,SUB(LEN(txt$),1),SUB(line,1),L:XBIOS(2))
  305. RETURN
  306. ' **********
  307. '
  308. > PROCEDURE initio.fastprint
  309.   ' *** PRINT txt$, but much faster than PRINT AT(1,line);txt$
  310.   ' *** High-resolution only !!
  311.   ' *** no VT52-commands (e.g. reverse text) possible !!
  312.   ' *** intitialize with @initio.fastprint, then use Procedure Fastprint
  313.   ' *** routine by Peter Schapermeier, improved by Kees Roos
  314.   '
  315.   ' *** load FASTPRT2.INL (192 bytes) here
  316.   INLINE fastprint%,192
  317.   {fastprint%+2}={L~A-22}       ! font-address
  318.   {fastprint%+6}=XBIOS(2)       ! use XBIOS(3) for (invisible) logical screen
  319. RETURN
  320. ' ***
  321. > PROCEDURE fastprint(col,lin,txt$)
  322.   ~C:fastprint%(L:ARRPTR(txt$),W:col,lin)
  323. RETURN
  324. ' **********
  325. '
  326. > PROCEDURE nicebox.text(col,lin,txt$)
  327.   ' *** print text with box at column,line with TEXT (8x16 system font)
  328.   ' *** High resolution only
  329.   LOCAL x1,y1,x2,y2,width
  330.   x1=(col-1)*8-4
  331.   y1=(lin-1)*16-2
  332.   width=8*LEN(txt$)
  333.   x2=x1+width+7
  334.   y2=y1+16+3
  335.   BOX x1,y1,x2,y2
  336.   BOX x1-1,y1-1,x2+1,y2+1
  337.   BOX x1-4,y1-4,x2+4,y2+4
  338.   DEFTEXT black,0,0,13
  339.   TEXT x1+4,y1+14,width,txt$
  340. RETURN
  341. ' **********
  342. '
  343.